home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Oberon⁄F™ 1.1 / Obx / Mod / Omosi (.txt) < prev    next >
Encoding:
Oberon Document  |  1996-01-05  |  11.3 KB  |  248 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. MODULE ObxOmosi;
  19.     IMPORT Domains, Ports, Stores, Views, Controllers, Properties, Dialog;
  20.     CONST
  21.         outside = -1; white = 0; top = 1; left = 2; right = 3;    (* Kind *)
  22.         gridDefault = FALSE;
  23.         version = 0;
  24.     TYPE
  25.         Palette = ARRAY 4 OF Ports.Color;
  26.         Kind = INTEGER;
  27.         Field = RECORD
  28.             kind: Kind;
  29.             sel: BOOLEAN
  30.         END;
  31.         Row = ARRAY 8 OF Field;
  32.         Model = ARRAY 15 OF Row;
  33.         StdView = POINTER TO StdViewDesc;
  34.         StdViewDesc = RECORD (Views.ViewDesc)
  35.             (* persistent state *)
  36.             pal: Palette;
  37.             mod: Model;
  38.             (* non-persistent state *)
  39.             sel: INTEGER;
  40.             grid: BOOLEAN
  41.         END;
  42.         FieldPath = ARRAY 3 OF Ports.Point;
  43.         FieldOp = POINTER TO FieldOpDesc;
  44.         FieldOpDesc = RECORD (Domains.OperationDesc)
  45.             v: StdView; i, j: INTEGER; kind: Kind
  46.         END;
  47.         ColorOp = POINTER TO ColorOpDesc;
  48.         ColorOpDesc = RECORD (Domains.OperationDesc)
  49.             v: StdView; n: INTEGER; col: Ports.Color
  50.         END;
  51.         UpdateMsg = RECORD (Views.Message)
  52.             i, j: INTEGER
  53.         END;
  54.     PROCEDURE InitRow (VAR row: Row; k: INTEGER);
  55.         VAR i, l, r: INTEGER;
  56.     BEGIN
  57.         l := (8 - k) DIV 2; r := 8 - l;
  58.         i := 0; WHILE i < l DO row[i].kind := outside; INC(i) END;
  59.         WHILE i < r DO row[i].kind := white; INC(i) END;
  60.         WHILE i < 8 DO row[i].kind := outside; INC(i) END;
  61.         i := 0; WHILE i < 8 DO row[i].sel := FALSE; INC(i) END
  62.     END InitRow;
  63.     PROCEDURE InitPalette 
  64. ield(v, f, x, y, i1, j1); 
  65.             IF (i1 # i) OR (j1 # j) THEN
  66.                 IF ~(Controllers.extend IN buttons) THEN SelectField(v, f, i, j, FALSE) END;
  67.                 i := i1; j := j1;
  68.                 SelectField(v, f, i, j, ~prevSel OR ~(Controllers.extend IN buttons))
  69.             END
  70.         UNTIL ~isDown;
  71.         IF ~(Controllers.extend IN buttons) & ((i # i0) OR (j # j0) OR ~prevSel) THEN
  72.             SelectField(v, f, i, j, FALSE)
  73.         END;
  74.         IF ValidField(v, i, j) THEN
  75.             IF Controllers.modify IN buttons THEN
  76.                 Dialog.GetColor(v.pal[v.mod[j, i].kind], col, setCol);
  77.                 IF setCol THEN
  78.                     NEW(cop); cop.v := v; cop.n := v.mod[j, i].kind; cop.col := col;
  79.                     Views.Do(v, "Color Change", cop)
  80.                 END
  81.             ELSIF ~(Controllers.extend IN buttons) THEN
  82.                 Views.BeginScript(v, "Omosi Change", script);
  83.                 j := 0;
  84.                 WHILE j < 15 DO
  85.                     i := 0;
  86.                     WHILE i < 8 DO
  87.                         IF (v.mod[j, i].sel OR (i = i1) & (j = j1)) & (v.mod[j, i].kind > outside) THEN
  88.                             NEW(op); op.v := v; op.i := i; op.j := j;
  89.                             op.kind := (v.mod[j, i].kind + 1) MOD 4;
  90.                             Views.Do(v, "", op)
  91.                         END;
  92.                         INC(i)
  93.                     END;
  94.                     INC(j)
  95.                 END;
  96.                 Views.EndScript(v, script)
  97.             END
  98.         END
  99.     END Track;
  100.     (* FieldOp *)
  101.     PROCEDURE (op: FieldOp) Do;
  102.         VAR k: Kind; msg: UpdateMsg;
  103.     BEGIN
  104.         k := op.v.mod[op.j, op.i].kind;
  105.         op.v.mod[op.j, op.i].kind := op.kind;
  106.         op.kind := k;
  107.         msg.i := op.i; msg.j := op.j; Views.Broadcast(op.v, msg)
  108.     END Do;
  109.     (* ColorOp *)
  110.     PROCEDURE (op: ColorOp) Do;
  111.         VAR c: Ports.Color;
  112.     BEGIN
  113.         c := op.v.pal[op.n]; op.v.pal[op.n] := op.col; op.col := c;
  114.         Views.Update(op.v, Views.keepFrames)
  115.     END Do;
  116.     (* View *)
  117.     PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
  118.         VAR i, j: INTEGER;
  119.     BEGIN
  120.         v.Externalize^(wr);
  121.         wr.WriteVersion(version);
  122.         i := 0; WHILE i < 4 DO wr.WriteLInt(v.pal[i]); INC(i) END;
  123.         j := 0;
  124.         WHILE j < 15 DO
  125.             i := 0; WHILE i < 8 DO wr.WriteInt(v.mod[j, i].kind); INC(i) END;
  126.             INC(j)
  127.         END
  128.     END Externalize;
  129.     PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
  130.         VAR i, j: INTEGER; ver: SHORTINT;
  131.     BEGIN
  132.         v.Internalize^(rd);
  133.         IF ~rd.cancelled THEN
  134.             rd.ReadVersion(version, version, ver);
  135.             IF ~rd.cancelled THEN
  136.                 i := 0; WHILE i < 4 DO rd.ReadLInt(v.pal[i]); INC(i) END;
  137.                 j := 0;
  138.                 WHILE j < 15 DO
  139.                     i := 0;
  140.                     WHILE i < 8 DO rd.ReadInt(v.mod[j, i].kind); v.mod[j, i].sel := FALSE; INC(i) END;
  141.                     INC(j)
  142.                 END;
  143.                 v.grid := FALSE
  144.             END
  145.         END
  146.     END Internalize;
  147.     PROCEDURE (v: StdView) CopyFrom (source: Views.View);
  148.     BEGIN
  149.         v.CopyFrom^(source);
  150.         WITH source: StdView DO
  151.             v.pal := source.pal; v.mod := source.mod;
  152.             v.sel := source.sel; v.grid := gridDefault
  153.         END
  154.     END CopyFrom;
  155.     PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  156.         VAR i, j: INTEGER;
  157.     BEGIN
  158.         j := 0;
  159.         WHILE j < 15 DO
  160.             i := 0; WHILE i < 8 DO DrawField(v, f, i, j); INC(i) END;
  161.             INC(j)
  162.         END
  163.     END Restore;
  164.     PROCEDURE (v: StdView) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
  165.     BEGIN
  166.         WITH msg: UpdateMsg DO
  167.             DrawField(v, f, msg.i, msg.j)
  168.         ELSE
  169.         END
  170.     END HandleViewMsg;
  171.     PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  172.                                                                 VAR focus: Views.View);
  173.         VAR i, j, sel: INTEGER;
  174.     BEGIN
  175.         WITH msg: Controllers.TrackMsg DO
  176.             Track(v, f, msg.x, msg.y, msg.modifiers)
  177.         | msg: Controllers.PollOpsMsg DO
  178.             msg.selectable := TRUE; msg.deselectable := TRUE
  179.         | msg: Controllers.SelectMsg DO
  180.             Select(v, msg.set)
  181.         ELSE
  182.         END
  183.     END HandleCtrlMsg;
  184.     PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
  185.         CONST minW = 3 * Ports.mm; stdW = 7 * Ports.mm;    (* per field *)
  186.     BEGIN
  187.         WITH msg: Properties.SizePref DO
  188.             IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
  189.                 Properties.ProportionalConstraint(1000, 2 * H(1000), msg.fixedW, msg.fixedH, msg.w, msg.h);
  190.                 IF msg.w < 8 * minW THEN
  191.                     msg.w := 8 * minW; msg.h := 16 * H(minW)
  192.                 END
  193.             ELSE
  194.                 msg.w := 8 * stdW; msg.h := 16 * H(stdW)
  195.             END;
  196.             INC(msg.h, 1 * Ports.mm)
  197.         | msg: Properties.FocusPref DO
  198.             msg.setFocus := TRUE
  199.         ELSE
  200.         END
  201.     END HandlePropMsg;
  202.     (* commands *)
  203.     PROCEDURE Deposit*;
  204.         VAR v: StdView;
  205.     BEGIN
  206.         NEW(v); InitPalette(v.pal); InitModel(v.mod); v.sel := 0; v.grid := FALSE; Views.Deposit(v)
  207.     END Deposit;
  208.     PROCEDURE ToggleGrid*;
  209.         VAR v: Views.View;
  210.     BEGIN
  211.         v := Controllers.FocusView();
  212.         IF v # NIL THEN
  213.             WITH v: StdView DO
  214.                 v.grid := ~v.grid; Views.Update(v, Views.keepFrames)
  215.             ELSE
  216.             END
  217.         END 
  218.     END ToggleGrid;
  219.     PROCEDURE ResetColors*;
  220.         VAR v: Views.View; p0: Palette; script: Domains.Operation; cop: ColorOp; i: INTEGER;
  221.     BEGIN
  222.         v := Controllers.FocusView();
  223.         IF v # NIL THEN
  224.             WITH v: StdView DO
  225.                 Views.BeginScript(v, "Reset Colors", script);
  226.                 InitPalette(p0);
  227.                 i := 0;
  228.                 WHILE i < 4 DO
  229.                     NEW(cop); cop.v := v; cop.n := i; cop.col := p0[i]; Views.Do(v, "", cop); INC(i)
  230.                 END;
  231.                 Views.EndScript(v, script)
  232.             ELSE
  233.             END
  234.         END 
  235.     END ResetColors;
  236. END ObxOmosi.
  237. TextControllers.StdCtrlDesc
  238. TextControllers.ControllerDesc
  239. Containers.ControllerDesc
  240. Controllers.ControllerDesc
  241. TextRulers.StdRulerDesc
  242. TextRulers.RulerDesc
  243. TextRulers.StdStyleDesc
  244. TextRulers.StyleDesc
  245. TextRulers.AttributesDesc
  246. Helvetica
  247. Documents.ControllerDesc
  248.